{--
    By using each of the digits from the set, {1, 2, 3, 4}, exactly once, 
    and making use of the four arithmetic operations (+, , *, /) and brackets/parentheses, 
    it is possible to form different positive integer targets.

    For example,

    8 = (4 * (1 + 3)) / 2
    14 = 4 * (3 + 1 / 2)
    19 = 4 * (2 + 3)  1
    36 = 3 * 4 * (2 + 1)

    Note that concatenations of the digits, like 12 + 34, are not allowed.
    
    Using the set, {1, 2, 3, 4}, it is possible to obtain thirty-one different target numbers
    of which 36 is the maximum, and each of the numbers 1 to 28 can be obtained before 
    encountering the first non-expressible number.
    
    Find the set of four distinct digits, a  b < c  d, for which the longest set of consecutive positive integers, 1 to n, can be obtained, giving your answer as a string: abcd.
    -}
    
{-
Congratulations, the answer you gave to problem 93 is correct.

You are the 3558th person to have solved this problem.

([?, ?, ?, ?], [1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 9.0, 10.0, 11.0, 12.0, 13.0, 14.0, 15.0, 16.0, 17.0, 18.0, 19.0, 20.0, 21.0, 22.0, 23.0, 24.0, 25.0, 26.0, 27.0, 28.0, 29.0, 30.0, 31.0, 32.0, 33.0, 34.0, 35.0, 36.0, 37.0, 38.0, 39.0, 40.0, 41.0, 42.0, 43.0, 44.0, 45.0, 46.0, 47.0, 48.0, 49.0, 50.0, 51.0])
runtime 17.8 wallclock seconds.

The tricky part is that intermediate non integer results are allowed.
National Rank: 390
Level 3, Rank 329
-}    

module examples.Euler93 where

import frege.data.List
-- import frege.data.Tuples
import frege.Prelude hiding(div)
import Prelude.Math(floor)

sets = [ map Int.double [a,b,c,d] | a <- [0..9], 
                     b <- [0..9], b > a, 
                     c <- [0..9], c > b, -- c != a,
                     d <- [0..9], d > c, -- d != b, d != c 
                     ]

--- since we are doing this often, it may pay off to specialize 'liftM2' on 'Maybe'
liftM2MB :: (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
liftM2MB f (Just a) (Just b) = Just (a `f` b)
liftM2MB f _ _ = Nothing
-- numbers [x] = [x]
-- numbers (x:xs) = concatMap (\d -> if d != 0 then [x+d, x-d, x*d, x `quot` d] else [x+d, x-d, x*d]) (numbers xs)  
-- numbers [] = []
plus, minus, times, div :: Maybe Double -> Maybe Double -> Maybe Double
plus = liftM2MB (+)
-- minus a b = if a < b then Nothing else liftM2 (-) a b
minus a b = liftM2MB (-) a b
times = liftM2MB (*)
div a (Just 0.0) = Nothing
div a b = liftM2MB (/) a b

ops = [plus, minus, times, div]

numbers :: [Maybe Double] -> [Double]
numbers [a,b,c,d] = filter (\x -> floor x == x)
    (catMaybes [ ((a `op1` b) `op2` c) `op3` d | op1 <- ops, op2 <- ops, op3 <- ops ]  
    ++ catMaybes [ (a `op1` b) `op2` (c `op3` d) | op1 <- ops, op2 <- ops, op3 <- ops ]
    ++ catMaybes [ a `op1` (b `op2` (c `op3` d)) | op1 <- ops, op2 <- ops, op3 <- ops ]
    ++ catMaybes [ (a `op1` (b `op2` c)) `op3` d | op1 <- ops, op2 <- ops, op3 <- ops ]
    ++ catMaybes [ a `op1` ((b `op2` c) `op3` d) | op1 <- ops, op2 <- ops, op3 <- ops ])
numbers _ = undefined    

allnumbers = uniq • sort • filter (1.0<=) • concatMap (numbers • map Just) • permutations
 
sequ (a:b:xs) 
    | 1.0 + a == b = a : sequ (b:xs)
    | otherwise = [a]
sequ xs = xs
       
main _ = do
    -- println $ "We have " ++ show (length sets) ++ " sets."
    -- println $ "Numbers of " ++ show (head sets) ++ " are " 
    --             ++ show (sequ (allnumbers [1.0,2.0,3.0,4.0]))
    let sn = zip sets (map (sequ • allnumbers) sets)
    println (maximumBy (comparing (length•snd)) sn)                
